home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / skk / skk-auto.el.z / skk-auto.el
Encoding:
Text File  |  1998-05-21  |  14.1 KB  |  292 lines
  1. ;;; skk-auto.el --- $BAw$j2>L>$N<+F0=hM}$N$?$a$N%W%m%0%i%`(B
  2. ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997
  3. ;; Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  4.  
  5. ;; Author: Masahiko Sato <masahiko@kuis.kyoto-u.ac.jp>
  6. ;; Maintainer: Mikio Nakajima <minakaji@osaka.email.ne.jp>
  7. ;; Version: $Id: skk-auto.el,v 1.2 1997/08/24 15:25:43 mrt Exp $
  8. ;; Keywords: japanese
  9. ;; Last Modified: $Date: 1997/08/24 15:25:43 $
  10.  
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either versions 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; This program is distributed in the hope that it will be useful
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with SKK, see the file COPYING.  If not, write to the Free
  23. ;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
  24. ;; MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27. ;; Following people contributed modifications to skk-server.el (Alphabetic
  28. ;; order):
  29. ;;
  30. ;;      Mikio Nakajima <minakaji@osaka.email.ne.jp>
  31.  
  32. ;;; Change log:
  33. ;; version 1.0.6 released 1997.2.18 (derived from the skk.el 8.6)
  34.  
  35. ;;; Code:
  36. (require 'skk-foreword)
  37. (require 'skk-vars)
  38.  
  39. ;;; user variables
  40. (defvar skk-kana-rom-vector
  41.   ["x" "a" "x" "i" "x" "u" "x" "e" "x" "o" "k" "g" "k" "g" "k" "g"
  42.    "k" "g" "k" "g" "s" "z" "s" "j" "s" "z" "s" "z" "s" "z" "t" "d"
  43.    "t" "d" "x" "t" "d" "t" "d" "t" "d" "n" "n" "n" "n" "n" "h" "b"
  44.    "p" "h" "b" "p" "h" "b" "p" "h" "b" "p" "h" "b" "p" "m" "m" "m"
  45.    "m" "m" "x" "y" "x" "y" "x" "y" "r" "r" "r" "r" "r" "x" "w" "x"
  46.    "x" "w" "n"]
  47.   "*skk-remove-common $B$G;HMQ$9$k$+$JJ8;z$+$i%m!<%^;z$X$NJQ49%k!<%k!#(B
  48. $B2<5-$N3:Ev$9$k$+$JJ8;z$r$=$NJ8;z$N%m!<%^;z%W%l%U%#%C%/%9$G8=$o$7$?$b$N!#(B
  49.     $B$!(B  $B$"(B  $B$#(B  $B$$(B  $B$%(B  $B$&(B  $B$'(B  $B$((B  $B$)(B  $B$*(B  $B$+(B  $B$,(B  $B$-(B  $B$.(B  $B$/(B  $B$0(B
  50.     $B$1(B  $B$2(B  $B$3(B  $B$4(B  $B$5(B  $B$6(B  $B$7(B  $B$8(B  $B$9(B  $B$:(B  $B$;(B  $B$<(B  $B$=(B  $B$>(B  $B$?(B  $B$@(B
  51.     $B$A(B  $B$B(B  $B$C(B  $B$D(B  $B$E(B  $B$F(B  $B$G(B  $B$H(B  $B$I(B  $B$J(B  $B$K(B  $B$L(B  $B$M(B  $B$N(B  $B$O(B  $B$P(B
  52.     $B$Q(B  $B$R(B  $B$S(B  $B$T(B  $B$U(B  $B$V(B  $B$W(B  $B$X(B  $B$Y(B  $B$Z(B  $B$[(B  $B$\(B  $B$](B  $B$^(B  $B$_(B  $B$`(B
  53.     $B$a(B  $B$b(B  $B$c(B  $B$d(B  $B$e(B  $B$f(B  $B$g(B  $B$h(B  $B$i(B  $B$j(B  $B$k(B  $B$l(B  $B$m(B  $B$n(B  $B$o(B  $B$p(B
  54.     $B$q(B  $B$r(B  $B$s(B
  55. $B$=$l$>$l$N$+$JJ8;z$,Aw$j2>L>$G$"$k>l9g$K$I$N%m!<%^;z%W%l%U%#%C%/%9$rBP1~$5$;$k(B
  56. $B$N$+$r;XDj$9$k$3$H$,$G$-$k!#!V$8!W!"!V$A!W!"!V$U!W$NJ8;z$K$D$$$F!"BP1~$9$k%m!<(B
  57. $B%^;z%W%l%U%#%C%/%9$r(B \"z\", \"c\",\"f\" $B$KJQ99$r4uK>$9$k>l9g$b$"$k$G$"$m$&!#(B
  58. skk-auto-okuri-process $B$NCM$,(B non-nil $B$N$H$-$N$_;2>H$5$l$k!#(B" )
  59.  
  60. (defvar skk-auto-load-hook nil
  61.   "*skk-auto.el $B$r%m!<%I$7$?8e$K%3!<%k$5$l$k%U%C%/!#(B" )
  62.  
  63. ;; internal valriables
  64. ;;;###skk-autoload
  65. (skk-deflocalvar skk-henkan-in-minibuff-flag nil
  66.   "$B%_%K%P%C%U%!$G<-=qEPO?$r9T$C$?$H$-$K$3$N%U%i%0$,N)$D!#(B
  67. skk-remove-common $B$G;2>H$5$l$k!#(B" )
  68.  
  69. (skk-deflocalvar skk-okuri-index-min -1
  70.   "skk-henkan-list $B$N%$%s%G%/%9$G<+F0Aw$j=hM}$G8!:w$7$?:G=i$N8uJd$r;X$9$b$N!#(B" )
  71.  
  72. (skk-deflocalvar skk-okuri-index-max -1
  73.   "skk-henkan-list $B$N%$%s%G%/%9$G<+F0Aw$j=hM}$G8!:w$7$?:G8e$N8uJd$r;X$9$b$N!#(B" )
  74.  
  75. (defun skk-okuri-search ()
  76.   ;; skk-auto-okuri-process $B$,(B non-nil $B$J$i$P(B "Uresii" $B$N$h$&$KAw$j2>L>$b4^$a(B
  77.   ;; $B$F%?%$%W$7$F$bAw$j$"$j$N(B "$B4r$7$$(B" $B$rC5$7=P$9!#(B
  78.   (if (and skk-auto-okuri-process
  79.            (not (or skk-abbrev-mode skk-process-okuri-early
  80.                     skk-henkan-okurigana ))
  81.            ;; we don't do auto-okuri-process if henkan key contains numerals.
  82.            (not (skk-numeric-p))
  83.            (> (length skk-henkan-key) skk-kanji-len) )
  84.       (let (l)
  85.         (setq skk-okuri-index-min (length skk-henkan-list)
  86.               l (skk-okuri-search-subr)
  87.               skk-okuri-index-max (+ skk-okuri-index-min (length l)) )
  88.         l )))
  89.  
  90. (defun skk-okuri-search-subr ()
  91.   ;; skk-okuri-search $B$N%5%V%k!<%A%s!#8+$D$1$?%(%s%H%j$N%j%9%H$rJV$9!#(B
  92.   (let* ((henkan-key skk-henkan-key)
  93.          (key (substring henkan-key 0 skk-kanji-len))
  94.          (len (length henkan-key))
  95.          (key1 (concat "\n" key))
  96.          key2 len2 key3 len3 okuri3
  97.          ;; $B8zN($,NI$$$h$&$K(B kanji-flag, mc-flag, enable-multibyte-characters
  98.          ;; $B$r(B nil $B$K$7$F$*$/!#(B
  99.          mc-flag
  100.          ;; enable-multibyte-characters
  101.          ;; case-fold-search $B$O!"<-=q%P%C%U%!$G$O>o$K(B nil$B!#(B
  102.          ;;case-fold-search
  103.          (inhibit-quit t)
  104.          key-cand-alist p q r s )
  105.     (save-match-data
  106.       (with-current-buffer (skk-get-jisyo-buffer skk-jisyo)
  107.         (goto-char skk-okuri-ari-min)
  108.         (while (search-forward key1 skk-okuri-ari-max t)
  109.           (setq p (point)
  110.                 key2 (concat key (skk-buffer-substring
  111.                                   p (- (search-forward " ") 2) ))
  112.                 len2 (length key2) )
  113.           (if (not (and (<= len2 len)
  114.                         (string= key2 (substring henkan-key 0 len2)) ))
  115.               nil
  116.             (let ((cont t))
  117.               (skk-save-point
  118.                (end-of-line)
  119.                (setq q (point)) )
  120.               (while (and cont (search-forward "/[" q t))
  121.                 (setq r (point))
  122.                 (setq okuri3 (skk-buffer-substring r (1- (search-forward "/")))
  123.                       key3 (concat key2 okuri3)
  124.                       len3 (length key3) )
  125.                 (if (not (and (<= len3 len)
  126.                               (string= key3 (substring henkan-key 0 len3)) ))
  127.                     nil
  128.                   ;; finally found a candidate!
  129.                   (let ((okuri
  130.                          (concat okuri3 (substring henkan-key len3 len)) )
  131.                         cand )
  132.                     (while (not (eq (following-char) ?\]))
  133.                       (setq cand
  134.                             (concat
  135.                              (skk-buffer-substring
  136.                               (point)
  137.                               (1- (search-forward "/" skk-okuri-ari-max t)) )
  138.                              okuri ))
  139.                       ;; $B8+=P$78l$,0c$C$F$b8uJd$,F1$8$3$H$,$"$jF@$k!#(B
  140.                       ;;   $B$+$s(Bz /$B46(B/[$B$8(B/$B46(B/]/
  141.                       ;;   $B$+$s(Bj /$B46(B/[$B$8(B/$B46(B/]/
  142.                       ;; $B$J$I!#(B
  143.                       (if (null (rassoc cand key-cand-alist))
  144.                           (setq key-cand-alist (cons (cons key3 cand)
  145.                                                      key-cand-alist ))))
  146.                     ;; it is not necessary to seach for "\[" on this line
  147.                     ;; any more
  148.                     (setq cont nil) ))))))
  149.         ;; key3 $B$ND9$$$b$N=g$K%=!<%H$7$FJV$9!#(B
  150.         (mapcar (function
  151.                  (lambda (x) (cdr x)) )
  152.                 (sort (nreverse key-cand-alist)
  153.                       (function (lambda (x y)
  154.                                   (string< (car y) (car x)) ))))))))
  155.  
  156. ;;;###skk-autoload
  157. (defun skk-remove-common (word)
  158.   ;; skk-henkan-key $B$H(B word $B$N4V$K6&DL$NAw$j2>L>$r<h$j=|$-!"Aw$j2>L>0J30$NItJ,(B
  159.   ;; $B$NJ8;zNs$rJV$9!#(Bskk-henkan-key $B$H(B skk-henkan-okurigana $B$NCM$r%;%C%H$9$k!#(B
  160.   ;; $BNc$($P!"(Bword == $B;}$C$F$-$?(B $B$G$"$l$P!"(Bskk-henkan-key := "$B$b(Bt",
  161.   ;; skk-henkan-okurigana := "$B$C$F(B", word := "$B;}(B" $B$N$h$&$KJ,2r$7!"(Bword $B$rJV$9!#(B
  162.   ;; skk-auto-okuri-process $B$NCM$,(B non-nil $B$G$"$k$H$-$K$3$N4X?t$r;HMQ$9$k!#(B
  163.   (if (and (not (skk-numeric-p)) (not skk-abbrev-mode)
  164.            (or skk-henkan-in-minibuff-flag
  165.                (and (<= skk-okuri-index-min skk-henkan-count)
  166.                     (<= skk-henkan-count skk-okuri-index-max) )))
  167.       (let ((midasi skk-henkan-key)
  168.             (midasi-len (length skk-henkan-key))
  169.             (word-len (length word))
  170.             (kanji-len2 (* 2 skk-kanji-len))
  171.             (mc-flag t)
  172.             (enable-multibyte-characters t)
  173.             (cont t)
  174.             char pos pos2 midasi-tail word-tail new-word okuri-first
  175.             new-skk-henkan-key )
  176.         (if (not (and (>= midasi-len kanji-len2) (>= word-len kanji-len2)))
  177.             nil
  178.           ;; check if both midasi and word end with the same ascii char.
  179.           (if (and (eq (aref midasi (1- midasi-len)) (aref word (1- word-len)))
  180.                    (skk-alpha-char-p (aref midasi (1- midasi-len))) )
  181.               ;; if so chop off the char from midasi and word
  182.               (setq midasi (substring midasi 0 -1)
  183.                     midasi-len (1- midasi-len)
  184.                     word (substring word 0 -1)
  185.                     word-len (1- word-len) ))
  186.           (setq midasi-tail (substring midasi (- midasi-len skk-kanji-len)
  187.                                        midasi-len )
  188.                 word-tail (substring word (- word-len skk-kanji-len)
  189.                                      word-len ))
  190.           ;; $B$b$&>/$7E83+$G$-$=$&$@$,!"%P%$%H%3%s%Q%$%i!<$,%*%W%F%#%^%$%:$7$d(B
  191.           ;; $B$9$$$h$&$K(B not $B$rIU$1$k$@$1$K$7$F$*$/!#(B
  192.           (if (not (and (string= midasi-tail word-tail)
  193.                         (or (and (skk-string<= "$B$!(B" midasi-tail)
  194.                                  (skk-string<= midasi-tail "$B$s(B") )
  195.                             (member midasi-tail '("$B!"(B" "$B!#(B" "$B!$(B" "$B!%(B")) )))
  196.               nil
  197.             (setq pos (- word-len skk-kanji-len)
  198.                   new-word new-skk-henkan-key )
  199.             (while (and cont (> pos 0))
  200.               (setq char (substring word (- pos skk-kanji-len) pos))
  201.               (if (and (skk-string<= "$B0!(B" char) (skk-string<= char "$Bt$(B"))
  202.                   ;; char is the right-most Kanji
  203.                   (setq cont nil)
  204.                 (setq pos (- pos skk-kanji-len)) ))
  205.             (setq pos2 (- midasi-len (- word-len pos)))
  206.             ;; check if midasi and word has the same tail of length
  207.             (if (not (string= (substring midasi pos2 midasi-len)
  208.                               (substring word pos word-len) ))
  209.                 nil
  210.               (setq okuri-first (substring word pos (+ pos skk-kanji-len)))
  211.               (setq skk-henkan-okurigana
  212.                     (if (and (string= okuri-first "$B$C(B")
  213.                              (<= (+ pos kanji-len2) word-len) )
  214.                         ;; in this case okuriga consits of two
  215.                         ;; characters, e.g., $B!V;D$C$?!W(B
  216.                         (substring word pos (+ pos kanji-len2))
  217.                       okuri-first ))
  218.               (setq new-word (substring word 0 pos))
  219.               (setq new-skk-henkan-key
  220.                     (concat
  221.                      (substring midasi 0 pos2)
  222.                      (cond ((string= okuri-first "$B$s(B")
  223.                             "n" )
  224.                            ((string= okuri-first "$B$C(B")
  225.                             (aref skk-kana-rom-vector
  226.                                   (- (string-to-char
  227.                                       (substring
  228.                                        skk-henkan-okurigana
  229.                                        (1- kanji-len2) kanji-len2 ))
  230.                                      161 )))
  231.                            (t (aref skk-kana-rom-vector
  232.                                     (- (string-to-char
  233.                                         (substring
  234.                                          skk-henkan-okurigana
  235.                                          (1- skk-kanji-len)
  236.                                          skk-kanji-len ))
  237.                                        161 ))))))
  238.               (if (not skk-henkan-in-minibuff-flag)
  239.                   (setq word new-word
  240.                         skk-henkan-key new-skk-henkan-key )
  241.                 ;; ask if register as okuri-ari word.
  242.                 (let (inhibit-quit) ; allow keyboard quit
  243.                   (if (y-or-n-p
  244.                        (format
  245.                         (if skk-japanese-message-and-error
  246.                             "%s /%s/ $B$rAw$j$"$j%(%s%H%j$H$7$FEPO?$7$^$9$+!)(B"
  247.                           "Shall I register this as okuri-ari entry: %s /%s/ ? " )
  248.                         new-skk-henkan-key new-word ))
  249.                       (setq word new-word
  250.                             skk-henkan-key new-skk-henkan-key )
  251.                     (setq skk-henkan-okurigana nil
  252.                           skk-okuri-char nil )
  253.                     (message "") ))))))))
  254.   ;; $BJ,2r$7$?(B word ($BAw$j2>L>ItJ,$r=|$$$?$b$N(B) $B$rJV$9!#(B
  255.   word )
  256.  
  257. ;;;###skk-autoload
  258. (defun skk-init-auto-okuri-variables ()
  259.   ;; skk-auto.el $B$NFbItJQ?t$r=i4|2=$9$k!#(B
  260.   (setq skk-henkan-in-minibuff-flag nil
  261.         skk-okuri-index-min -1
  262.         skk-okuri-index-max -1 ))
  263.  
  264. ;;;###skk-autoload
  265. (defun skk-adjust-search-prog-list-for-auto-okuri ()
  266.   ;; skk-auto-okuri-process $B$,(B nil $B$G$"$l$P!"(Bskk-search-prog-list $B$+$i(B 
  267.   ;; '(skk-okuri-search) $B$r>C$7!"(Bnon-nil $B$G$"$l$P2C$($k!#(B
  268.   ;;
  269.   ;; '(skk-okuri-search) $B$r2C$($k0LCV$K$D$$$F$O!"(Bskk-jisyo $B$N8e$,:GNI$+$I$&$+(B
  270.   ;; $B$OJ,$i$J$$$N$G!"%*%W%7%g%s$GJQ99$G$-$k$h$&$K$9$Y$-$@$,(B...$B!#(B
  271.   (if (not skk-auto-okuri-process)
  272.       (setq skk-search-prog-list
  273.             (delete '(skk-okuri-search) skk-search-prog-list) )
  274.       (if (null (member '(skk-okuri-search) skk-search-prog-list))
  275.           (let ((pl skk-search-prog-list)
  276.                 (n 0) dic mark )
  277.             (while pl
  278.               (setq dic (car pl))
  279.               (if (eq (nth 1 dic) 'skk-jisyo)
  280.                   (setq mark n
  281.                         pl nil)
  282.                 (setq pl (cdr pl)
  283.                       n (1+ n) )))
  284.             (skk-middle-list skk-search-prog-list
  285.                              (1+ mark) '((skk-okuri-search)) )))))
  286.  
  287. ;;(add-hook 'skk-mode-hook 'skk-adjust-search-prog-list-for-auto-okuri)
  288.  
  289. (run-hooks 'skk-auto-load-hook)
  290. (provide 'skk-auto)
  291. ;;; skk-auto.el ends here
  292.